Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/text_utl/vuestr/viewer.frm

Visual Basic Form | 1995-05-22 | 10.0 KB | 292 lines

VERSION 2.00
Begin Form Viewer
   BackColor       =   &H00C0C0C0&
   Caption         =   "VBstrAPI Huge Array Viewer Demo"
   ClientHeight    =   3615
   ClientLeft      =   540
   ClientTop       =   2175
   ClientWidth     =   7575
   Height          =   4305
   Left            =   480
   LinkTopic       =   "Form1"
   ScaleHeight     =   3615
   ScaleWidth      =   7575
   Top             =   1545
   Width           =   7695
   Begin PictureBox InfoBar
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   330
      Left            =   0
      ScaleHeight     =   300
      ScaleWidth      =   7545
      TabIndex        =   1
      Top             =   0
      Width           =   7575
      Begin Label Status
         BackStyle       =   0  'Transparent
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00800000&
         Height          =   270
         Left            =   120
         TabIndex        =   2
         Top             =   45
         Width           =   3195
      End
   End
   Begin CommonDialog CMDialog1
      Left            =   60
      Top             =   2025
   End
   Begin TextBox MainView
      BackColor       =   &H00C0C0C0&
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Courier New"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2565
      Left            =   570
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      TabStop         =   0   'False
      Tag             =   "OL"
      Top             =   570
      Width           =   4935
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFileOpen
         Caption         =   "&Open"
      End
      Begin Menu mnuFileExit
         Caption         =   "&Exit"
      End
   End
   Begin Menu mnuFirst
      Caption         =   "&First Page"
   End
   Begin Menu mnuPrev
      Caption         =   "&Prev Page"
   End
   Begin Menu mnuNext
      Caption         =   "&Next Page"
   End
   Begin Menu mnuLast
      Caption         =   "&Last Page"
   End
   Begin Menu mnuAbout
      Caption         =   "&About"
   End
Option Explicit
Const BUFFER_SIZE = 32768
Dim SHandle     As Long     ' ArrayStr Handle
Dim SPages      As Integer  ' String Pages Used
Dim CHandle     As Long     ' CatStr Handle
Dim CurrentPage As Integer  ' Currently displayed page
Sub About ()
    MsgBox "This program demonstrates a method of viewing large text files.  This demo does not attempt to demonstrate editing techniques.  That will be covered in another demo." + Chr$(10) + "" + Chr$(10) + "VBstrAPI.DLL Copyright " & Chr(169) & " 1995, Greg Truesdell", 64, "VBstrAPI Viewer Demonstration"
End Sub
Sub Form_Activate ()
    About
End Sub
Sub Form_Load ()
    SHandle = -1
    CHandle = CreateNewCatString(BUFFER_SIZE)
    If CHandle = -1 Then
    MsgBox "The program was unable to create a CatStr Object." + Chr$(10) + "This usually means there is not enough memory.", 16, "Unable to Continue"
    Unload Me
    End If
    ' setting page to zero resets the menu
    SetCurrentPage 0
    Me.Width = screen.Width * .8
    Me.Left = screen.Width * .1
    Me.Top = screen.Height * .1
    Me.Height = screen.Height * .8
End Sub
Sub Form_Paint ()
    Outlines Me
End Sub
Sub Form_Resize ()
    On Error Resume Next
    MainView.Left = 120
    MainView.Top = InfoBar.Height + 120
    MainView.Width = ScaleWidth - 240
    MainView.Height = ScaleHeight - 240 - InfoBar.Height
    On Error GoTo 0
End Sub
Sub Form_Unload (Cancel As Integer)
    If CHandle > -1 Then DestroyCatString CHandle
    If SHandle > -1 Then DestroyStringArray SHandle
End Sub
Sub mnuAbout_Click ()
    About
End Sub
Sub mnuFileExit_Click ()
    Unload Me
End Sub
'=============================================================
'=  Created:    05/20/95 at 09:59 AM
'=  Project:    VIEWSTR.MAK
'=  Author:     Greg Truesdell
'=============================================================
'=  Purpose:    Open and Read a File into a ArrayStr Array.
'=  Parameters: None.
'=  Returns:    ArrayStr associated with the global SHandle
'=              variable is loaded with the contents of the
'=              the file.  The global SPages variable is
'=              updated with the count of ArrayStr elements
'=              containing text.
'=============================================================
Sub mnuFileOpen_Click ()
  Dim CFilename As String   ' the file to open
  Dim File      As Integer  ' the file handle
  Dim FLen      As Long     ' the file length
  Dim PageGuess As Integer  ' best guess at size of array
  Dim Text      As String   ' a line of text
  Dim rc        As Integer  ' generic return code
    On Error GoTo OpenCancel
    CMDialog1.DialogTitle = "Open Text File for Viewing"
    CMDialog1.Filename = ""
    CMDialog1.InitDir = ""
    CMDialog1.Filter = "All Files (*.*)|*.*|"
    CMDialog1.FilterIndex = 1
    CMDialog1.MaxFileSize = 256
    CMDialog1.DefaultExt = "*.*"
    CMDialog1.HelpFile = ""
    CMDialog1.HelpCommand = &H1
    CMDialog1.HelpContext = 0
    CMDialog1.CancelError = True
    CMDialog1.Flags = 22540
    CMDialog1.Action = 1
    On Error GoTo OpenError
    CFilename = CMDialog1.Filename
    FLen = FileLen(CFilename)
    ' ignore empty files
    If FLen = 0 Then
    MsgBox "The file '" & CFilename & "' is empty.", 64, "File Empty"
    GoTo OpenExit
    End If
    ' now, open the file
    File = FreeFile
    Open CFilename For Input As #File
    On Error GoTo ReadError
    ' start with a new string array
    If SHandle > -1 Then DestroyStringArray SHandle
    ' estimate the size of array required, then add 1 more element
    PageGuess = (FLen / BUFFER_SIZE) + 1
    PageGuess = PageGuess + 1
    ' create the array, exit on error
    SHandle = CreateNewStringArray(PageGuess, BUFFER_SIZE)
    If SHandle = -1 Then
    MsgBox "Unable to allocate an ArrayStr large enough to contain the file.", 16, "ArrayStr Creation Error"
    GoTo OpenExit
    End If
    ' read the file
    ' this method of reading files is slow, but we need to do
    ' it this way for files larger than one array element
    SPages = 0
    CatStrClear CHandle
    Me.MousePointer = 11
    Do While Not EOF(File)
    Line Input #File, Text
    rc = CatStrAddLine(CHandle, Text)
    If rc = -1 Then ' CatStr is full.
        rc = PutArrayStr(SHandle, SPages, CatStrCopy(CHandle))
        CatStrClear CHandle
        SPages = SPages + 1
    End If
    Loop
    ' don't forget to pickup the last bit.
    If CatStrLength(CHandle) > 0 Then
    rc = PutArrayStr(SHandle, SPages, CatStrCopy(CHandle))
    CatStrClear CHandle
    SPages = SPages + 1
    End If
    ' done
    Close File
    Me.MousePointer = 0
    MsgBox "Filename:" + Chr(9) + CFilename + Chr$(10) + "File Size:" + Chr$(9) & FLen & Chr$(10) + "Array Pages:" + Chr$(9) & SPages & Chr$(10) + "Created Pages:" + Chr$(9) & PageGuess, 64, "Text File Loaded"
    ' call the procedure that displays pages and
    ' sets menu options
    '
    ' note: pages are numbered 1 to SPages
    SetCurrentPage 1
    GoTo OpenExit
' ================================================================
ReadError:
    MsgBox "Unable to Read file '" & CFilename & "'." + Chr$(10) + Error$, 16, "File Open Error"
    Close File
    Resume OpenExit
' ================================================================
OpenError:
    MsgBox "Unable to Open file '" & CFilename & "'." + Chr$(10) + Error$, 16, "File Open Error"
    Resume OpenExit
' ================================================================
OpenCancel:
    Resume OpenExit
' ================================================================
OpenExit:
    On Error GoTo 0
End Sub
Sub mnuFirst_Click ()
    SetCurrentPage 1
End Sub
Sub mnuLast_Click ()
    SetCurrentPage SPages
End Sub
Sub mnuNext_Click ()
    SetCurrentPage CurrentPage + 1
End Sub
Sub mnuPrev_Click ()
    SetCurrentPage CurrentPage - 1
End Sub
'=============================================================
'=  Created:    05/20/95 at 11:04 AM
'=  Project:    VIEWSTR.MAK
'=  Author:     Greg Truesdell
'=============================================================
'=  Purpose:    Set the MainView.Text to current ArrayStr
'=              page of text.
'=              Enable/Disable appropriate menu options.
'=  Parameters: Unary-based page number (1 to SPages)
'=              Page 0 is used to reset the menu
'=  Returns:    N/A
'=============================================================
Sub SetCurrentPage (page As Integer)
    CurrentPage = page
    Select Case page
    Case Is < 1
        Status.Caption = ""
        mnuFirst.Enabled = False
        mnuNext.Enabled = False
        mnuPrev.Enabled = False
        mnuLast.Enabled = False
        Exit Sub
    Case 1
        mnuFirst.Enabled = False
        mnuNext.Enabled = (SPages > 1)
        mnuPrev.Enabled = False
        mnuLast.Enabled = (SPages > 1)
    Case SPages
        mnuFirst.Enabled = (SPages > 1)
        mnuNext.Enabled = False
        mnuPrev.Enabled = (SPages > 1)
        mnuLast.Enabled = False
    Case Else
        mnuFirst.Enabled = (SPages > 1)
        mnuNext.Enabled = (page < SPages)
        mnuPrev.Enabled = (SPages > page)
        mnuLast.Enabled = True
    End Select
    MainView.Text = GetArrayStr(SHandle, page - 1)
    Status.Caption = "Page " & page & " of " & SPages
End Sub